Nesta análise iremos brincar um um pouco com dados sobre as unidades acadêmicas da Universidade Federal de Campina Grande. Mais especificamente, utilizaremos os seguintes dados:
UORG: Unidade acadêmica em questão.
Outro: Representa a quantidade de funcionários da unidade acadêmica que não são professores.
idade_75perc: 75 percentil do tempo de serviço público dos servidores.
prof20: Representa a quantidade professores da unidade acadêmica em jornada de 20 horas.
prof40: Representa a quantidade professores da unidade acadêmica em jornada de 40 horas ou em dedicação exclusiva.
library('tidyverse')
library('plotly')
library('ggplot2')
library('broom')
library('GGally')
dados = read_csv(file = "dados.csv")
dados_filtrados <- dados %>%
mutate(prof20 = `Professor 20h`,
prof40 = `Professor 40h ou DE`,
UORG = UORG_LOTACAO
) %>%
select(-`Professor 20h`,
-`Professor 40h ou DE`,
-idade_25perc,
-idade_mediana,
-UORG_LOTACAO) %>%
filter(complete.cases(dados))
Para ter uma noção melhor das relações entre as variáveis, utilizaremos um descritivo express que irá deixar claro se houver alguma correlação óbvia nos dados.
dados_filtrados %>%
select(-UORG) %>%
ggpairs(size = .5,
lower = list(continuous = wrap("points", size = .5, alpha = 0.3)))
Observando o descritivo express percebemos de cara que existe uma correlação média-forte entre as variáveis Outro e idade_75perc com valor de 0,606. Isso nos leva a entender que quantos mais funcionários não-professores, maior será o tempo de serviço público dos servidores (em geral) nessa unidade acadêmica. Será que isso é verdade? Vamos agrupar os dados e observar se vemos algum padrão.
Para embasar um pouco mais o agrupamento utilizei a estratégia de comparar:
1 - A distância entre o centro dos clusters e o centro dos dados.
2 - A distância entre cada ponto e o centro dos dados.
Com base na proporção dessas duas medidas é possível determinar um bom valor para o número de grupos, uma vez que quando a proporção entre as duas medidas para de aumentar não vale mais a pena aumentar o número de grupos.
how_many_groups = tibble(groups = 1:15) %>%
group_by(groups) %>%
do(
kmeans(dados_filtrados %>% select(idade_75perc),
centers = .$groups,
nstart = 20) %>% glance()
)
how_many_groups %>%
ggplot(aes(x = groups, y = betweenss / totss)) +
geom_line() +
geom_point()
Com base no gráfico acima decidi que 5 grupos seria uma boa quantidade para essa análise. E com a quantidade de grupos em mãos já é possível rodar o algoritmo kmeans e perceber o que os dados podem nos mostrar. Nessa análise resolvi utilizar apenas uma dimensão, o 75 percentil do tempo de serviço público dos servidores.
dados_filtrados_km <- dados_filtrados %>% select(idade_75perc) %>% kmeans(centers = 5, nstart = 20)
dados_filtrados_agrupado = dados_filtrados_km %>% augment(dados_filtrados)
Utilizando um gráfico de coordenadas paralelas fica ainda mais clara a nossa hipótese sobre a relação entre o número de servidores não-professores e a idade dos funcionários em geral, principalmente nos grupos 2 e 3. Vamos observar a média do número de servidores de cada grupo e a média do 75-percentil do tempo de serviço e ver se isso nos diz alguma coisa:
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 1))$Outro)
## [1] 5.142857
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 1))$idade_75perc)
## [1] 7.995248
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 2))$Outro)
## [1] 12.91667
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 2))$idade_75perc)
## [1] 33.9969
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 3))$Outro)
## [1] 6.727273
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 3))$idade_75perc)
## [1] 24.01827
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 4))$Outro)
## [1] 0.3333333
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 4))$idade_75perc)
## [1] 1.653288
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 5))$Outro)
## [1] 4.333333
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 5))$idade_75perc)
## [1] 13.42783
Observando as métricas de cada grupo conseguimos observar um padrão (não tão claro, até porque a correlação não é tão forte) em que um maior número de servidores realmente incide numa maior idade nas pessoas de uma certa unidade acadêmica. Isso fica ainda mais claro quando observamos o grupo 2 no qual a maior média de servidores não-professores corresponde a maior média dos 75-percentis de tempo de serviço.
Interessante ainda notar o grupo 4, onde o 75 percentil do tempo de serviço público é bastante baixo quando comparado aos outros grupos (assim como a quantidade de servidores/professores). Mais estranho ainda é que todos as 3 unidades acadêmicas nesse grupo possuem apenas 1 professor. Talvez por serem departamentos novos? Podemos verificar na visualização interativa mais abaixo.
dados_filtrados_km %>%
augment(dados_filtrados) %>%
gather(key = "variável", value = "valor", -UORG, -.cluster) %>%
ggplot(aes(x = `variável`, y = valor, group = UORG, colour = .cluster, colors="Set2")) +
geom_line(alpha = .2) +
facet_wrap(~ .cluster, scales ="free_x")
plot_ly(
dados_filtrados_agrupado,
x = ~Outro,
y = ~idade_75perc,
color = ~as.character(.cluster),
type="scatter",
mode="markers",
colors = "Set1",
text = ~paste("<b>",UORG, "</b><br>", "<b>Profs. 20 horas: </b>", prof20, "<br><b>Profs. 40 horas:</b> ", prof40,"<br><b>Servidores: </b>", Outro, "<br><b>75-percentil do tempo de serviço: </b>", format(round(idade_75perc, 2), nsmall=2)),
hoverinfo = "text"
)
Observando a variável idade_75perc mostrada nos dados do grupo 4 percebemos que temos servidores com mais de 2 anos de serviço nesses departamentos, ou seja essas unidades acadêmicas já não são tão novas assim. Então por que será que temos tão poucos funcionários/professores nelas? Será que está faltando recursos para fazer contratações? Fica aqui o questionamento…
Encontrando os componentes com base nas variáveis originais:
dados_pca = dados_filtrados %>% column_to_rownames('UORG') %>% prcomp(scale=FALSE)
A relação entre os componentes encontrados e as variáveis originais
print(as.data.frame(dados_pca$rotation))
## PC1 PC2 PC3 PC4
## Outro -0.2332847 0.2340374 -0.1775033 0.92698292
## idade_75perc -0.2794284 0.7501979 -0.4846147 -0.35252153
## prof20 -0.1162517 -0.5806125 -0.8049966 -0.03681216
## prof40 -0.9241123 -0.2128819 0.2926117 -0.12278478
Podemos ainda ver quanta variância é capturada por cada PC:
tidy(dados_pca, "pcs") %>%
ggplot(aes(x = PC, y = cumulative, label = cumulative)) +
geom_line() +
geom_point() +
geom_text(vjust = 1, hjust = -.1)
Agora vamos tentar achar a mesma estrutura de grupos que achamos usando K-means, mas dessa vez com as variáveis PC. Vejamos a visualização abaixo que mostra os grupos achados anteriormente agora de acordo com as variáveis PC:
au <- augment(dados_pca, dados_filtrados_agrupado)
plot_ly(
au,
x = ~.fittedPC2,
y = ~.fittedPC4,
color = ~as.character(.cluster),
type = "scatter",
mode = "markers",
colors = "Set1",
text = ~paste("<b>",UORG, "</b><br>", "<b>Profs. 20 horas: </b>", prof20, "<br><b>Profs. 40 horas:</b> ", prof40,"<br><b>Servidores: </b>", Outro, "<br><b>75-percentil do tempo de serviço: </b>", format(round(idade_75perc, 2), nsmall=2)),
hoverinfo = "text"
)
Nesta breve análise, foi possível perceber a utilidade da ténica de PCA principalmente para agrupamentos. Muitas vezes reduzir a dimensão dos dados facilita a percepção de relações que de outra maneira estariam escondidas. Isso é possível apenas devido ao poder do PCA de comprimir informações multidimensionais e apresenta-las para nós na forma de uma visualização bidimensional, que facilita a percepção de padrões por nós humanos.
Comparando esta última visualização que utiliza PCA com a anterior podemos achar que houve uma certa bagunça nos dados, até porque alguns pontos que são de um mesmo grupo agora aparecem bem mais distantes. Porém, este é o poder do PCA, explicitar semelhanças e diferenças que de outra maneira não estariam visíveis. A Unidade Acadêmica de Medicina do grupo 3 por exemplo, está bem distante dos outros pontos do seu grupo pois possui um grande número de professores em regime de 20 horas comparado a outras unidades, algo que não estava perceptível na visualização anterior e foi explicitado utilizando PCA.